home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TEXTFILE.SWG / 0021_Sorting a Text file.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  4KB  |  155 lines
  1. {
  2. MARK OUELLET
  3.  
  4. > I know, Mark, that is what Mike said in his last post on it,
  5. > however, when I tried to make that correction the error simply changed
  6. > from an unrecognized Variable to a Type mismatch.  I kept the Program
  7. > and may be able to rework it.  I think Mike indicated originally that it
  8. > was untested. I kept a copy and may get back to it later.   I thought
  9. > (grin) that you might come along and supply the missing touch!!  I've
  10. > profited greatly by the instruction of your skilled hand as well as that
  11. > of Mike's.
  12.  
  13.     The Type mismatch comes from the fact Mike elected to use a general
  14. purpose Pointer Type For his Array rather than defining a new String
  15. Pointer Type.
  16.  
  17.     Ok, you have two possible solutions to the problem. You can (A)
  18. TypeCast every Pointer use With String() as in
  19.  
  20.    if PA[MIDDLE]^ < S
  21.  
  22. BECOMES
  23.  
  24.    if String(PA[MIDDLE]^) < S
  25.  
  26. This one is long and requires adding the Typecast to every single
  27. comparison. Or you can (B) define a new StrPointer Type and redefine the
  28. Array to an Array of StrPointer.
  29.  
  30. Here is a version that should work correctly. I decided to go With the
  31. String Pointer Type since Mike Uses GetMem anyways. if he had been using
  32. NEW() then each allocation would have been For a 255 caracter String but
  33. since he allready Uses GetMem to request just enough to hold the String
  34. then the new Type will pose no problems.
  35.  
  36.     Note that some additions and Modifications have also been done to
  37. make it work. I guess Mike was pretty tired when he wrote this ;-). The
  38. sorting routine does work as is, just as Mike stated. I also took it
  39. upon myself to reformat it to my standards.
  40. }
  41.  
  42.  
  43. {$A+,B-,D+,E-,F+,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T+,V-,X+,Y+}
  44. {$M 65520,100000,655360}
  45. {
  46.   Written by Mike Copeland and Posted to the Pascal Lessons echo
  47.   on April 10th 1993.
  48.  
  49.   Modified by Mark Ouellet on May 3rd 1993 and reposted to Pascal
  50.   Lessons echo.
  51.  
  52.   Modifications are not indicated in any way to avoid loading the echo
  53.   too much. A File compare of both versions will point out the obvious
  54.   modifications and additions.
  55. }
  56. Program Text_File_SORT;
  57.  
  58. Uses
  59.   Dos, Crt, Printer;
  60.  
  61. Const
  62.   MAXL = 10000;   { maximum # of Records to be processed }
  63.  
  64. Type
  65.   BBUF       = Array[1..16384] of Char;
  66.   StrPointer = ^String;
  67.  
  68. Var
  69.   I    : Word;
  70.   IDX  : Word;
  71.   P    : StrPointer;
  72.   S    : String;
  73.   BP   : ^BBUF;                       { large buffer For Text File i/o }
  74.   PA   : Array [1..MAXL] of StrPointer;{ Pointer Array }
  75.   F    : Text;
  76.  
  77. Procedure Pause;
  78. begin
  79.   { Flush Keyboard buffer }
  80.   Asm
  81.     Mov AX, 0C00h;
  82.     Int 21h
  83.   end;
  84.   Writeln('Press a key to continue...');
  85.   { Wait For Keypress }
  86.   While not KeyPressed do;
  87.   { Flush Keyboard Buffer again, we don't need the key }
  88.   Asm
  89.     Mov AX, 0C00h;
  90.     Int 21h
  91.   end;
  92. end;
  93.  
  94. Procedure L_HSORT (LEFT, RIGHT : Word);{ Lo-Hi QuickSort }
  95. Var
  96.   LOWER,
  97.   UPPER,
  98.   MIDDLE : Word;
  99.   PIVOT,
  100.   T      : String;
  101.   Temp   : StrPointer;
  102. begin
  103.   LOWER  := LEFT;
  104.   UPPER  := RIGHT;
  105.   MIDDLE := (LEFT + RIGHT) Shr 1;
  106.   PIVOT  := PA[MIDDLE]^;
  107.   Repeat
  108.     While PA[LOWER]^ < PIVOT do
  109.       Inc(LOWER);
  110.     While PIVOT < PA[UPPER]^ do
  111.       Dec(UPPER);
  112.     if LOWER <= UPPER then
  113.     begin
  114.       Temp := PA[LOWER];
  115.       PA[LOWER] := PA[UPPER];
  116.       PA[UPPER] := Temp;
  117.       Inc (LOWER);
  118.       Dec (UPPER);
  119.     end;
  120.   Until LOWER > UPPER;
  121.   if LEFT < UPPER then
  122.     L_HSORT (LEFT, UPPER);
  123.   if LOWER < RIGHT then
  124.     L_HSORT (LOWER, RIGHT);
  125. end; { L_HSORT }
  126.  
  127. begin
  128.   ClrScr;
  129.   Assign (F,'input.dat');
  130.   New (BP);
  131.   SetTextBuf (F,BP^);
  132.   Reset (F);
  133.   IDX := 0;
  134.   While not EOF (F) do
  135.   begin          { read File; load into Heap }
  136.     readln (F,S);
  137.     Inc (IDX);
  138.     GetMem (P,Length(S)+1);
  139.     P^ := S;
  140.     PA[IDX] := P;
  141.     gotoXY (1,22);
  142.     Write (IDX:5)
  143.   end;
  144.   Close (F);
  145.   Dispose (BP);
  146.   if IDX > 1 then
  147.     L_HSORT (1,IDX);                  { sort the data }
  148.   For I := 1 to IDX do begin          { display the data }
  149.     Writeln (PA[I]^);
  150.     if not Boolean(I MOD 23) then
  151.       pause;
  152.   end;
  153.   Writeln ('Finis...')
  154. end.
  155.